home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / XLIBP202.ZIP / XCONVERT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-23  |  9KB  |  403 lines
  1. Program XConvert;
  2.  
  3. Uses
  4.     Crt, XBm2, XMisc2, XGif2, Dos;
  5.  
  6. var
  7.     i : integer;
  8.     dir, tmp : DirStr;
  9.     name : NameStr;
  10.     DestExt,ext : ExtStr;
  11.     filenamein, filenameout, filenamewild : string;
  12.     S : SearchRec;
  13.     NextParam, TConv : string;
  14.     gifheight, gifwidth, error, StartParam, ConvFrom, Conversion : integer;
  15.     inbuff, outbuff : ^TByteArray;
  16.     inbuffoff : longint;
  17.     filein, fileout : file;
  18.  
  19. const
  20.     CBitmapWidth : integer = 80;
  21.  
  22. procedure GetPicLine( Var pixels; line, width : integer ); far;
  23. begin
  24.     blockwrite( fileout, pixels, width );
  25. end;
  26.  
  27. procedure DiscardPicLine( Var pixels; line, width : integer ); far;
  28. begin
  29. end;
  30.  
  31. procedure StoreLineBuff( Var pixels; line, width : integer ); far;
  32. begin
  33.     gifwidth := width;
  34.     gifheight := line+1;
  35.     if inbuffoff+width<65519 then
  36.         move( pixels, inbuff^[inbuffoff], width );
  37.     inbuffoff := inbuffoff + width;
  38. end;
  39.  
  40. function convert( filenamein, filenameout : string; ctype, intype : integer ) : boolean;
  41. var
  42.     size : longint;
  43.     actual : word;
  44.  
  45.     procedure Dealloc;
  46.     begin
  47.         freemem( inbuff, 65520 );
  48.         freemem( outbuff, 65520 );
  49.     end;
  50.  
  51. begin
  52.     inbuffoff := 0;
  53.     getmem( inbuff, 65520 );
  54.     getmem( outbuff, 65520 );
  55.     if Ctype=4 then
  56.     if (inType<>2) then
  57.         begin
  58.             writeln(' Invalid format ');
  59.             convert := false;
  60.             Dealloc;
  61.             exit;
  62.         end else
  63.         begin
  64.             GIFOutLineProc := GetPicLine;
  65.             {$I-}
  66.             assign(fileout, filenameout);
  67.             rewrite(fileout,1);
  68.             {$I+}
  69.             if IoResult>0 then
  70.             begin
  71.                 write(' Rewrite ');
  72.                 convert := false;
  73.                 Dealloc;
  74.                 exit;
  75.             end;
  76.             if LoadGif( filenamein ) > 0 then
  77.             begin
  78.                 write(' Invalid GIF file ');
  79.                 convert := false;
  80.                 Dealloc;
  81.                 close( fileout );
  82.                 exit;
  83.             end;
  84.             close( fileout );
  85.             convert := true;
  86.             Dealloc;
  87.             exit;
  88.         end;
  89.     if Ctype=3 then
  90.         if (inType<>2) then
  91.         begin
  92.             writeln(' No Pal Info ');
  93.             convert := false;
  94.             Dealloc;
  95.             exit;
  96.         end else
  97.         begin
  98.             GIFOutLineProc := DiscardPicLine;
  99.             {$I-}
  100.             assign(fileout, filenameout);
  101.             rewrite(fileout,1);
  102.             {$I+}
  103.             if IoResult>0 then
  104.             begin
  105.                 write(' Rewrite ');
  106.                 convert := false;
  107.                 Dealloc;
  108.                 exit;
  109.             end;
  110.             if LoadGif( filenamein ) > 0 then
  111.             begin
  112.                 write(' Invalid GIF file ');
  113.                 convert := false;
  114.                 Dealloc;
  115.                 close( fileout );
  116.                 exit;
  117.             end;
  118.             blockwrite( fileout, GIFPalette, sizeof(GIFPalette) );
  119.             close( fileout );
  120.             convert := true;
  121.             Dealloc;
  122.             exit;
  123.         end;
  124.     if intype = 2 then
  125.     begin
  126.         GIFOutLineProc := StoreLineBuff;
  127.         {$I-}
  128.         assign(fileout, filenameout);
  129.         rewrite(fileout,1);
  130.         {$I+}
  131.         if IoResult>0 then
  132.         begin
  133.             write(' Rewrite ');
  134.             convert := false;
  135.             Dealloc;
  136.             exit;
  137.         end;
  138.         if LoadGIF( filenamein ) > 0 then
  139.         begin
  140.             write(' Invalid GIF file ');
  141.             convert := false;
  142.             Dealloc;
  143.             close( fileout );
  144.             exit;
  145.         end;
  146.         if inbuffoff > 65516 then
  147.         begin
  148.             write(' >64K ');
  149.             convert := false;
  150.             Dealloc;
  151.             close( fileout );
  152.             exit;
  153.         end;
  154.         if (ctype=1) and (gifwidth mod 4 <>0) then
  155.         begin
  156.             write(' Width is not a multiple of 4 ');
  157.             convert := false;
  158.             Dealloc;
  159.             close( fileout );
  160.             exit;
  161.         end;
  162.         if (gifwidth>255) or (gifheight>255) then
  163.         begin
  164.             write(' Image too big ');
  165.             convert := false;
  166.             Dealloc;
  167.             close( fileout );
  168.             exit;
  169.         end;
  170.         outbuff^[0] := gifwidth;
  171.         error := 1;
  172.         outbuff^[error] := gifheight;
  173.         move( inbuff^, outbuff^[error+1], inbuffoff );
  174.         size := inbuffoff+2;
  175.         case CType of
  176.             0 : ;
  177.             1 : xbmtopbm(outbuff^,inbuff^);
  178.             2 :
  179.                 begin
  180.                     if inbuffoff > 19000 then
  181.                     begin
  182.                         write(' Image too big ');
  183.                         convert := false;
  184.                         Dealloc;
  185.                         close( fileout );
  186.                         exit;
  187.                     end else
  188.                     begin
  189.                         size := xsizeofcbitmap(CBitmapWidth,outbuff^);
  190.                         xcompilebitmap(CBitmapWidth, inbuff^, outbuff^);
  191.                     end;
  192.                 end;
  193.             else
  194.                 begin
  195.                     writeln(' Can''t handle ');
  196.                     convert := false;
  197.                     close( filein );
  198.                     close( fileout );
  199.                     Dealloc;
  200.                     exit;
  201.                 end;
  202.         end;
  203.  
  204.         blockwrite( fileout, outbuff^, size, Actual );
  205.         close( fileout );
  206.  
  207.         convert := true;
  208.         Dealloc;
  209.         exit
  210.     end;
  211.     if ( Ctype>=0 ) and ( Ctype<=2 ) and ( intype>=0 ) and (intype<=1) then
  212.     begin
  213.         if Ctype = InType then
  214.         begin
  215.             write(' Nothing to do ');
  216.             Dealloc;
  217.             convert := false;
  218.             exit;
  219.         end;
  220.         {$I-}
  221.         assign(filein, filenamein);
  222.         reset(filein,1);
  223.         {$I+}
  224.         if IoResult>0 then
  225.         begin
  226.             write(' Reset ');
  227.             convert := false;
  228.             Dealloc;
  229.             exit;
  230.         end;
  231.         {$I-}
  232.         assign(fileout, filenameout);
  233.         rewrite(fileout,1);
  234.         {$I+}
  235.         if IoResult>0 then
  236.         begin
  237.             write(' Rewrite ');
  238.             convert := false;
  239.             Dealloc;
  240.             close( filein );
  241.             exit;
  242.         end;
  243.         size := filesize(filein);
  244.         if size>65528 then
  245.         begin
  246.             write(' >64K ');
  247.             convert := false;
  248.             Dealloc;
  249.             close( filein );
  250.             close( fileout );
  251.             exit;
  252.         end;
  253.         blockread( filein, inbuff^, size, Actual );
  254.         if actual<>size then
  255.         begin
  256.             write(' Read ');
  257.             convert := false;
  258.             close( filein );
  259.             close( fileout );
  260.             Dealloc;
  261.             exit;
  262.         end;
  263.         case ctype of
  264.             0 : if intype = 1 then xpbmtobm(inbuff^,outbuff^);
  265.             1 : if intype = 0 then xbmtopbm(inbuff^,outbuff^);
  266.             2 :
  267.                 begin
  268.                     if intype = 1 then
  269.                     begin
  270.                         size := xsizeofcpbm(CBitmapWidth,inbuff^);
  271.                         xcompilepbm(CBitmapWidth,inbuff^,outbuff^);
  272.                     end else
  273.                     begin
  274.                         size := xsizeofcbitmap(CBitmapWidth,inbuff^);
  275.                         xcompilebitmap(CBitmapWidth, inbuff^, outbuff^);
  276.                     end;
  277.                 end;
  278.             else
  279.                 begin
  280.                     writeln(' Can''t handle ');
  281.                     convert := false;
  282.                     close( filein );
  283.                     close( fileout );
  284.                     Dealloc;
  285.                     exit;
  286.                 end;
  287.         end;
  288.         blockwrite( fileout, outbuff^, size, Actual );
  289.         if actual<>size then
  290.         begin
  291.             write(' Write ');
  292.             convert := false;
  293.             close( filein );
  294.             close( fileout );
  295.             Dealloc;
  296.             exit;
  297.         end;
  298.         close( filein );
  299.         close( fileout );
  300.     end;
  301.     convert := true;
  302.     Dealloc;
  303. end;
  304.  
  305. procedure syntax;
  306. begin
  307.     writeln;
  308.     writeln('XConvert is a conversion utility which will convert a number of files');
  309.     writeln('to a format understandable by XLib routines.');
  310.     writeln('XConvert can read the following formats : ');
  311.     writeln('  LBM - XLib Linear bitmap');
  312.     writeln('  PBM - XLib Planar bitmap');
  313.     writeln('  GIF - Compuserve GIF');
  314.     writeln;
  315.     writeln('XConvert can write the following formats : ');
  316.     writeln('  LBM - XLib Linear bitmap');
  317.     writeln('  PBM - XLib Planar bitmap');
  318.     writeln('  CBM - XLib Compiled bitmap');
  319.     writeln('  PAL - XLib raw palette');
  320.     writeln('  SCR - XLib raw screen format');
  321.     writeln;
  322.     writeln('The -W parameter is used to specify the logical screen width for CBM''s');
  323.     writeln('The default value is 80 which is valid for a 320 pixel screen');
  324.     writeln;
  325.     writeln('  Usage :');
  326.     writeln('    XConvert -<LBM|PBM|CBM|PAL> [-W xxx] <filespec> [ <filespec> ..]');
  327.     halt(0);
  328. end;
  329.  
  330. begin
  331.     writeln('XConvert v1.01 - XLib Conversion utility - FREEWARE');
  332. {$IFDEF DPMI}
  333.     write('DPMI Version - ');
  334. {$ENDIF}
  335.     writeln('(C) 1994 - Tristan Tarrant');
  336.     if paramcount < 2 then syntax;
  337.     TConv := ParamStr(1);
  338.     XStrUpCase( TConv );
  339.     if TConv='-LBM' then
  340.         Conversion := 0
  341.     else
  342.     if TConv='-PBM' then
  343.         Conversion := 1
  344.     else
  345.     if TConv='-CBM' then
  346.         Conversion := 2
  347.     else
  348.     if TConv='-PAL' then
  349.         Conversion := 3
  350.     else
  351.     if TConv='-SCR' then
  352.         Conversion := 4
  353.     else syntax;
  354.     StartParam := 2;
  355.     NextParam := Paramstr(2);
  356.     XStrUpCase( NextParam );
  357.     if NextParam = '-W' then
  358.     begin
  359.         if ParamCount<4 then syntax;
  360.         StartParam := 4;
  361.         val(ParamStr(3), CBitmapWidth, error );
  362.         if error >0 then syntax;
  363.     end;
  364.     DestExt := '.'+copy(TConv,2,3);
  365.     for i := StartParam to Paramcount do
  366.     begin
  367.         filenamewild := ParamStr(i);
  368.         XStrUpCase( filenamewild );
  369.         fsplit(filenamewild,dir,name,ext);
  370.         if ext = '' then ext := '.LBM';
  371.         filenamewild := dir+name+ext;
  372.         findfirst(filenamewild,Archive,S);
  373.         while DosError = 0 do
  374.         begin
  375.             fsplit(S.name,tmp,name,ext);
  376.             if (ext<>'.LBM') and
  377.                  (ext<>'.PBM') and
  378.                  (ext<>'.GIF') then
  379.                         writeln('Skipping  : ',S.name, ' -> unknown type.')
  380.             else
  381.             begin
  382.                 if ext='.LBM' then
  383.                     ConvFrom := 0
  384.                 else
  385.                 if ext='.PBM' then
  386.                     ConvFrom := 1
  387.                 else
  388.                 if ext='.GIF' then
  389.                     ConvFrom := 2;
  390.  
  391.                 filenamein := dir+name+ext;
  392.                 filenameout := dir+name+DestExt;
  393.                 write('Converting: ',filenamein,' -> ',filenameout);
  394.                 if convert(filenamein,filenameout,Conversion,ConvFrom) then
  395.                     writeln(' OK')
  396.                 else
  397.                     writeln(' FAILED');
  398.             end;
  399.             findnext(S);
  400.         end;
  401.     end;
  402. end.
  403.